home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1995.rar / 1995 / OCT / CJ9510 / main.pas < prev    next >
Pascal/Delphi Source File  |  1995-09-20  |  8KB  |  316 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus, Grids, DBGrids, DB, DBTables, StdCtrls, DBCtrls,
  8.   Mask, ExtCtrls, IniFiles, About;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     MainMenu1: TMainMenu;
  13.     OpenDialog1: TOpenDialog;
  14.     File1: TMenuItem;
  15.     New1: TMenuItem;
  16.     Open1: TMenuItem;
  17.     N1: TMenuItem;
  18.     Exit1: TMenuItem;
  19.     DataSource1: TDataSource;
  20.     Table1: TTable;
  21.     ScrollBox: TScrollBox;
  22.     Label1: TLabel;
  23.     Label2: TLabel;
  24.     Label3: TLabel;
  25.     Label4: TLabel;
  26.     Label5: TLabel;
  27.     Label6: TLabel;
  28.     Label7: TLabel;
  29.     Label8: TLabel;
  30.     Label9: TLabel;
  31.     Label10: TLabel;
  32.     Label11: TLabel;
  33.     Label12: TLabel;
  34.     Label13: TLabel;
  35.     EditCompanyName: TDBEdit;
  36.     EditLastName: TDBEdit;
  37.     EditFirstName: TDBEdit;
  38.     EditMrMrs: TDBEdit;
  39.     EditAddress: TDBEdit;
  40.     EditAddress2: TDBEdit;
  41.     EditCity: TDBEdit;
  42.     EditStateProv: TDBEdit;
  43.     EditZipPostalCode: TDBEdit;
  44.     EditPhone: TDBEdit;
  45.     EditFax: TDBEdit;
  46.     EditLastContact: TDBEdit;
  47.     MemoComments: TDBMemo;
  48.     Panel1: TPanel;
  49.     DBNavigator1: TDBNavigator;
  50.     MRUSep: TMenuItem;
  51.     MRU1: TMenuItem;
  52.     MRU2: TMenuItem;
  53.     MRU3: TMenuItem;
  54.     Help1: TMenuItem;
  55.     About1: TMenuItem;
  56.     Save1: TMenuItem;
  57.     procedure Open1Click(Sender: TObject);
  58.     procedure New1Click(Sender: TObject);
  59.     procedure Exit1Click(Sender: TObject);
  60.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  61.     procedure FormCreate(Sender: TObject);
  62.     procedure ShiftMRU(const fName: String);
  63.     procedure MRU1Click(Sender: TObject);
  64.     procedure CheckState;
  65.     procedure ValidateTable;
  66.     procedure CreateCardTable(Tab: TTable;const tabName: String);
  67.     procedure About1Click(Sender: TObject);
  68.     procedure DataSource1StateChange(Sender: TObject);
  69.     procedure Save1Click(Sender: TObject);
  70.   private
  71.     { Private declarations }
  72.   public
  73.     { Public declarations }
  74.   end;
  75.  
  76. var
  77.   Form1: TForm1;
  78.   IniFile: TIniFile;    {For access the Cards.Ini file}
  79.   LoadDir: String;      {For storing the application directory}
  80.  
  81. implementation
  82.  
  83. {$R *.DFM}
  84.  
  85. type
  86.   EBadTable = class(Exception);
  87.  
  88. procedure TForm1.Open1Click(Sender: TObject);
  89. var
  90.   oldTable: String;
  91. begin
  92.   {Permit selection of existing tables only}
  93.   OpenDialog1.Options := [ofFileMustExist];
  94.   if OpenDialog1.Execute then
  95.     begin
  96.       CheckState;
  97.       with Table1 do
  98.         begin
  99. { The following line is remmed out due to FieldDefs needed in ValidateTable procedure}
  100. {          FieldDefs.Clear;}
  101.           oldTable := Tablename;
  102.           if Active then Active:= False;
  103.           Tablename := OpenDialog1.FileName;
  104.           try
  105.             validateTable;
  106.           except
  107.             on EBadTable do
  108.               begin
  109.                 Tablename := oldTable;
  110.                 Active := True;
  111.                 Raise;
  112.               end;
  113.           end;
  114.             Active := True;
  115.             ShiftMRU(OpenDialog1.Filename);
  116.             Self.Caption := 'Cards: '+ OpenDialog1.Filename;
  117.         end;
  118.       end;
  119. end;
  120.  
  121. procedure TForm1.ShiftMRU(const fName: String);
  122. var
  123.   f1,f2,f3: String;
  124. begin
  125.   f1 := IniFile.ReadString('Files','File1','');
  126.   f2 := IniFile.ReadString('Files','File2','');
  127.   f3 := IniFile.ReadString('Files','File3','');
  128.   if not MRUSep.Visible then
  129.       MRUSep.Visible := True;
  130.   IniFile.WriteString('Files','File1',fName);
  131.   MRU1.Caption := fName;
  132.   MRU1.Visible := True;
  133.   IniFile.WriteString('Files','File2',f1);
  134.   IniFile.WriteString('Files','File3',f2);
  135.   if f1 <> '' then
  136.     begin
  137.       MRU2.Caption := f1;
  138.       MRU2.Visible := True;
  139.     end;
  140.   if f2 <> '' then
  141.     begin
  142.       MRU3.Caption := f2;
  143.       MRU3.Visible := True;
  144.     end;
  145. end;
  146.  
  147. procedure TForm1.New1Click(Sender: TObject);
  148. begin
  149. OpenDialog1.Options :=[];
  150. if OpenDialog1.Execute then
  151.   begin
  152.   CheckState;
  153.   if FileExists(OpenDialog1.Filename) then
  154.     begin
  155.       if MessageDlg('Replace '+OpenDialog1.Filename,
  156.            mtConfirmation,[mbOK,mbCancel],0) = mrCancel then
  157.            Exit;
  158.     end;
  159.  
  160.   CreateCardTable(Table1,OpenDialog1.Filename);
  161.   Table1.Active := True;
  162.   ShiftMRU(OpenDialog1.Filename);
  163.   Self.Caption := 'Cards: '+ OpenDialog1.Filename;
  164.   end;
  165. end;
  166.  
  167. procedure TForm1.Exit1Click(Sender: TObject);
  168. begin
  169. Close;
  170. end;
  171.  
  172. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  173. begin
  174. CheckState;
  175. end;
  176.  
  177. procedure TForm1.CheckState;
  178. begin
  179. if (Table1.State = dsEdit) or (Table1.State = dsInsert) then
  180.   if MessageDlg('Save changes to this record?',
  181.       mtConfirmation,[mbOK,mbCancel],0) = mrOK then
  182.   Table1.Post;
  183. end;
  184.  
  185. procedure TForm1.FormCreate(Sender: TObject);
  186. var
  187.   StartFile: String;
  188.   holdMRU: String;
  189. begin
  190.   LoadDir :=ExtractFilePath(ParamStr(0));
  191.   IniFile := TIniFile.Create(LoadDir + 'Cards.ini');
  192.   StartFile := IniFile.ReadString('Files','File1','');
  193.   if StartFile <> '' then
  194.      begin
  195.        with Table1 do
  196.          begin
  197.          Active := False;
  198.          Tablename := 'Default.db';
  199.          Active := True;
  200.          Self.Caption := 'CARDS: '+ StartFile;
  201.          MRUSep.Visible := True;
  202.          MRU1.Caption := StartFile;
  203.          MRU1.Visible := True;
  204.          holdMRU := IniFile.ReadString('Files','File2','');
  205.          if holdMRU <> '' then
  206.            begin
  207.              MRU2.Caption := holdMRU;
  208.              MRU2.Visible := True;
  209.              holdMRU := IniFile.ReadString('Files','File3','');
  210.              if holdMRU <> '' then
  211.                MRU3.Caption := holdMRU;
  212.                MRU3.Visible := True;
  213.            end;
  214.          end;
  215.      end
  216.   else
  217.     if FileExists(LoadDir + 'Default.db') then
  218.       begin
  219.         with Table1 do
  220.           begin
  221.             Active := False;
  222.             Tablename := 'Default.db';
  223.             Active := True;
  224.             Self.Caption := 'CARDS: '+ LoadDir + 'Default.db';
  225.             ShiftMRU(LoadDir + 'Default.db');
  226.             IniFile.WriteString('Files','File1',LoadDir + 'Default.db');
  227.           end;
  228.       end;
  229.  
  230. end;
  231.  
  232. procedure TForm1.MRU1Click(Sender: TObject);
  233. begin
  234. with Table1 do
  235.   begin
  236.     CheckState;
  237.     Active := False;
  238.     TableName := TMenuItem(Sender).Caption;
  239.     Active := True;
  240.     ShiftMRU(TMenuItem(Sender).Caption);
  241.   end;
  242. end;
  243.  
  244. procedure TForm1.About1Click(Sender: TObject);
  245. begin
  246. AboutBox.ShowModal;
  247. end;
  248.  
  249. procedure TForm1.ValidateTable;
  250. var
  251.   tempTable: TTable;
  252.   i: Integer;
  253. begin
  254. tempTable := TTable.Create(Form1);
  255. CreateCardTable(tempTable,'__temp.db');
  256. if Table1.FieldDefs.Count <> tempTable.FieldDefs.Count then
  257.   begin
  258.     tempTable.Free;
  259.     raise EBadTable.Create('Invalid number of fields');
  260.   end;
  261. for i := 1 to tempTable.FieldDefs.Count-1 do
  262.   begin
  263.   if (tempTable.FieldDefs.Items[i].Size <>
  264.       Table1.FieldDefs.Items[i].Size) OR
  265.       (tempTable.FieldDefs.Items[i].FieldClass <>
  266.       Table1.FieldDefs.Items[i].FieldClass) OR
  267.       (tempTable.FieldDefs.Items[i].Name <>
  268.       Table1.FieldDefs.Items[i].Name) then
  269.       begin
  270.         tempTable.Free;
  271.         raise EBadTable.Create('Invalid table structure');
  272.       end;
  273.   end;
  274. tempTable.Free;
  275. end;
  276.  
  277. procedure TForm1.CreateCardTable(Tab: TTable;const tabName: String);
  278. begin
  279.   with Tab do
  280.     begin
  281.     Active := False;
  282.     TableName := tabName;
  283.     with FieldDefs do
  284.       begin
  285.       Clear;
  286.       Add('CompanyName', ftString, 35,True);
  287.       Add('LastName', ftString, 18,False);
  288.       Add('FirstName', ftString, 15,False);
  289.       Add('Mr/Mrs', ftString, 10,False);
  290.       Add('Address1', ftString, 35,False);
  291.       Add('Address2', ftString, 35,False);
  292.       Add('City', ftString, 25,False);
  293.       Add('State/Prov', ftString, 25,False);
  294.       Add('Zip/Postal Code', ftString, 15,False);
  295.       Add('Phone', ftString, 20,False);
  296.       Add('Fax', ftString, 20,False);
  297.       Add('LastContact', ftDate, 0,False);
  298.       Add('Comments', ftMemo, 10,False);
  299.       end;
  300.     CreateTable;
  301.     AddIndex('CompanyIndex', 'CompanyName', [ixPrimary, ixUnique]);
  302.     end;
  303. end;
  304.  
  305. proced